perm filename PCHECK.M1[226,JMC] blob sn#005392 filedate 1972-07-09 generic text, type T, neo UTF8
00100	PUTPROP('LAMBDA,'LAMSTAT,'STAT);
00200	PUTPROP('GO,'GOSTAT,'STAT);
00300	
00400	EVALUATECAR ARG ←
00500	  BEGIN SCALAR NEWSTAT;
00600		IF ¬VALID(NEWSTAT←CARQUOTE ARG) THEN
00700			ERREND '(NOT A QUOTED EXPRESSION) ELSE
00800			ADDLINE(NEWSTAT,LIST('EVCAR,ARG),NIL);
00900			SHOWCURLINE();
01000	  END;
01100	
01200	CARQUOTE(ARG)←IF ATOM ARG ∨ ¬(CAR ARG EQ 'QUOTE)∨ ATOM CDR ARG
01300		∨ ¬NULL CDDR ARG THEN 'INVALID
01400		ELSE LIST('EQUAL,LIST('CAR,ARG),
01500			IF ATOM CADR ARG THEN 'UU
01600			ELSE LIST('QUOTE,CAADR ARG));
01700	
01800	FEXPR EVCAR ARG ← EVALUATECAR CAR ARG;
01900	
02000	EVALUATECDR ARG ←
02100	  BEGIN SCALAR NEWSTAT;
02200		IF ¬VALID(NEWSTAT←CDRQUOTE ARG) THEN
02300			ERREND '(NOT A QUOTED EXPRESSION) ELSE
02400			ADDLINE(NEWSTAT,LIST('EVCDR,ARG),NIL);
02500			SHOWCURLINE();
02600	  END;
02700	
02800	CDRQUOTE(ARG)←IF ATOM ARG ∨ ¬(CAR ARG EQ 'QUOTE)∨ ATOM CDR ARG
02900		∨ ¬NULL CDDR ARG THEN 'INVALID
03000		ELSE LIST('EQUAL,LIST('CDR,ARG),
03100			IF ATOM CADR ARG THEN 'UU
03200			ELSE LIST('QUOTE,CDADR ARG));
03300	
03400	FEXPR EVCDR ARG ← EVALUATECDR CAR ARG;
03500	
03600	EVALUATECONS(ARG1,ARG2) ←
03700	  BEGIN SCALAR NEWSTAT;
03800		IF ¬VALID(NEWSTAT←CONSQUOTE(ARG1,ARG2)) THEN
03900			ERREND '(NOT BOTH QUOTED EXPRESSIONS) ELSE
04000			ADDLINE(NEWSTAT,LIST('EVCONS,ARG1,ARG2),NIL);
04100			SHOWCURLINE();
04200	  END;
04300	
04400	CONSQUOTE(ARG1,ARG2) ←
04500		(LAMBDA(W1,W2);
04600			IF ¬(VALID W1 ∧ VALID W2) THEN 'INVALID
04700			ELSE LIST('EQUAL,LIST('CONS,ARG1,ARG2),
04800				LIST('QUOTE,CONS(SUBLIS(W1,'PPP),
04900					SUBLIS(W2,'PPP)))))
05000		(INST(ARG1,'(QUOTE PPP),NIL),INST(ARG2,'(QUOTE PPP),NIL));
05100	
05200	FEXPR EVCONS ARG ← EVALUATECONS(CAR ARG,CADR ARG);
05300	
05400	EVALUATEEQUAL(ARG1,ARG2) ←
05500	  BEGIN SCALAR NEWSTAT;
05600		IF ¬VALID(NEWSTAT←EQUALQUOTE(ARG1,ARG2)) THEN
05700			ERREND '(NOT BOTH QUOTED EXPRESSIONS) ELSE
05800			ADDLINE(NEWSTAT,LIST('EVEQUAL,ARG1,ARG2),NIL);
05900			SHOWCURLINE();
06000	  END;
06100	
06200	EQUALQUOTE(ARG1,ARG2) ←
06300		(LAMBDA(W1,W2);
06400			IF ¬(VALID W1 ∧ VALID W2) THEN 'INVALID
06500			ELSE IF W1=W2 THEN LIST('EQUAL,ARG1,ARG2)
06600			ELSE LIST('NOT,LIST('EQUAL,ARG1,ARG2)))
06700		(INST(ARG1,'(QUOTE PPP),NIL),INST(ARG2,'(QUOTE PPP),NIL));
06800	
06900	FEXPR EVEQUAL ARG ← EVALUATEEQUAL(CAR ARG,CADR ARG);
07000	
07100	EVALUATEATOM(ARG) ←
07200	  BEGIN SCALAR NEWSTAT;
07300		IF ¬VALID(NEWSTAT←ATOMQUOTE ARG) THEN
07400			ERREND '(NOT A QUOTED EXPRESSION) ELSE
07500			ADDLINE(NEWSTAT,LIST('EVATOM,ARG),NIL);
07600			SHOWCURLINE();
07700	  END;
07800	
07900	ATOMQUOTE ARG ←
08000		(LAMBDA(W);
08100			IF ¬VALID W THEN 'INVALID
08200			ELSE IF ATOM SUBLIS(W,'PPP) THEN LIST('ATOM,ARG)
08300			ELSE LIST('NOT,LIST('ATOM,ARG)))
08400		(INST(ARG,'(QUOTE PPP),NIL));
08500	
08600	FEXPR EVATOM ARG ← EVALUATEATOM CAR ARG;
08700	
08800	EVALUATESEXP(ARG) ←
08900	  BEGIN SCALAR NEWSTAT;
09000		IF ¬VALID(NEWSTAT←SEXPQUOTE ARG) THEN
09100			ERREND '(NOT A QUOTED EXPRESSION) ELSE
09200			ADDLINE(NEWSTAT,LIST('ISSEXP,ARG),NIL);
09300			SHOWCURLINE();
09400	  END;
09500	
09600	SEXPQUOTE ARG ←
09700		(LAMBDA(W);
09800			IF ¬VALID W THEN 'INVALID
09900	
10000			ELSE LIST('ISSEXP,ARG))
10100		(INST(ARG,'(QUOTE PPP),NIL));
10200	
10300	FEXPR ISSEXP ARG ← EVALUATESEXP CAR ARG;
10400	
10500	EVALUATELIST(ARG) ←
10600	  BEGIN SCALAR NEWSTAT;
10700		IF ¬VALID(NEWSTAT←LISTQUOTE ARG) THEN
10800			ERREND '(NOT A LIST OF QUOTED EXPRESSIONS) ELSE
10900			ADDLINE(NEWSTAT,'EVLIST.ARG,NIL);
11000			SHOWCURLINE();
11100	  END;
11200	
11300	LISTQUOTE ARGS ←
11400		IF LISTOK ARGS THEN
11500			LIST('EQUAL,CONS('LIST,ARGS),LIST('QUOTE,
11600				MAPLIST(FUNCTION CADAR,ARGS)))
11700		ELSE 'INVALID ;
11800	
11850	LISTOK ARGS ← NULL ARGS ∨ (VALID INST(ARGS,'((QUOTE PPP).QQQ),NIL)
11875					∧LISTOK CDR ARGS);
11900	
12000	FEXPR EVLIST ARGS ← EVALUATELIST ARGS;
12100	
12200	EVALUATEEVAL(ARG) ←
12300	  BEGIN SCALAR NEWSTAT;
12400		IF ¬VALID(NEWSTAT←EVALLQUOTE ARG) THEN
12500			ERREND '(NOT PROPERLY EVALUABLE EXPRESSION) ELSE
12600			ADDLINE(NEWSTAT,LIST('EVEVAL,ARG),NIL);
12700			SHOWCURLINE();
12800	  END;
12900	
13000	EVALLQUOTE ARG ←
13100		IF EVALOK ARG THEN
13200			LIST('EQUAL,LIST('EVAL,LIST('QUOTE,ARG)),
13250				LIST('QUOTE,EVAL ARG))
13400		ELSE 'INVALID ;
13500	
13600	EVALOK ARG ← T;
13800	
13900	FEXPR EVEVAL ARGS ← EVALUATEEVAL CAR ARGS;
     

00100	REMPROP('LAMBDA,'STAT);
00200	REMPROP('GO,'STAT);
00300	END;